VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsCreateXMLDecline"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Function XMLCreateDeclineReason(rsDeclRsn As ADODB.Recordset, strXmlString As String) As Boolean
    'dim strXmlString As String
  Dim xmldoc                  As MSXML2.DOMDocument
  Dim ProcessInst             As MSXML2.IXMLDOMProcessingInstruction
  
  Dim nKeytax                 As MSXML2.IXMLDOMNode
  Dim nResponse               As MSXML2.IXMLDOMNode
  
  Dim nlKeytax                As MSXML2.IXMLDOMNodeList
  Dim nlResponse              As MSXML2.IXMLDOMNodeList
  
  'Response
  Dim ellKeytax               As MSXML2.IXMLDOMElement
  Dim ellResponse             As MSXML2.IXMLDOMElement
  Dim ellSARSAppID            As MSXML2.IXMLDOMElement
  Dim ellDirectiveType        As MSXML2.IXMLDOMElement
  Dim ellCode                 As MSXML2.IXMLDOMElement
  Dim ellTextReason           As MSXML2.IXMLDOMElement
  
  
  
  
  On Error GoTo PROC_ERROR
  
  'barb
  'Set xmldoc = New MSXML2.DOMDocument
  Set xmldoc = New MSXML2.DOMDocument
  
  'barb
  'xmldoc.Load ("C:\Shane\Projects\LCB\FormB\XML Docs\Response\FormB_Decline_Response.xml")
  
  If xmldoc.xml = "" Then
  i = 0
  'Must always specify, depending on what response file you are working with
  nTypeResponse = "05"
  
      'get header xml file
      Dim sGetXMLHeader           As Object
      Dim strXMLHeader            As String
      Set sGetXMLHeader = CreateObject("GenericXMLHeader.clsGetXMLHeader")
      'GetXMLHeader(ByVal nReqSeqNum As String, ByVal nTypeResponse As String,ByRef nReferenceId As String, _
      'ByRef nComId As String, ByRef nBuId As String, ByRef nNewMessageID As String, ByRef sFormType As String)
      strXMLHeader = sGetXMLHeader.GetXMLHeader(nReqSeqNum, nTypeResponse, nReferenceId, nComId, _
                                                nBuId, nNewMessageID, sFormType, ServerName)
      xmldoc.loadXML (strXMLHeader)
      
'      Set nKeytax = xmldoc.selectSingleNode("Keytax")
'      Set xmldoc.documentElement = nKeytax
'
'      Set nlKeytax = xmldoc.getElementsByTagName("KeyTax")
'      Set ellKeytax = nlKeytax.Item(0)

        Set nKeytax = xmldoc.selectSingleNode("//KeyTax")
  
      'Get Response details
      Set nResponse = xmldoc.createElement("Response")
      Call nKeytax.appendChild(nResponse)
      Set ellResponse = nResponse
      Call ellResponse.setAttribute("Form", sFormType)
      
      Set ellSARSAppID = xmldoc.createElement("SARSAppID")
      ellSARSAppID.nodeTypedValue = nApplID
      Call nResponse.appendChild(ellSARSAppID)
      
      Set ellDirectiveType = xmldoc.createElement("DirectiveType")
      Call ellDirectiveType.setAttribute("Type", sDirType)
      Call nResponse.appendChild(ellDirectiveType)
     
  End If
     
  'i = i + 1
  If rsDeclRsn.RecordCount > 0 Then
    rsDeclRsn.MoveFirst
  'If i > 1 Then
    Dim nParentList As MSXML2.IXMLDOMNodeList
    Dim eParent As MSXML2.IXMLDOMElement
    Dim eChild As MSXML2.IXMLDOMElement
  
    Do While Not rsDeclRsn.EOF
''        'barb
''        'Set nlResponse = xmldoc.getElementsByTagName("Response ")
''        Set nlResponse = xmldoc.getElementsByTagName("Response")
''        Set nResponse = nlResponse.Item(0)
''
''        Set ellCode = xmldoc.createElement("Code")
''        ellCode.nodeTypedValue = nCode
''        Call nResponse.appendChild(ellCode)
''
''        Set ellTextReason = xmldoc.createElement("TextReason")
''        ellTextReason.nodeTypedValue = Trim(sReasonText)
''        Call nResponse.appendChild(ellTextReason)
        
        
        Set nParentList = xmldoc.getElementsByTagName("Response")
        Set eParent = nParentList.Item(0)
        Set eChild = xmldoc.createElement("Code")
        eChild.Text = CStr(rsDeclRsn!DECLINE_REASON_CODE)
        Call eParent.appendChild(eChild)
        
        Set eChild = xmldoc.createElement("TextReason")
        eChild.Text = CStr(rsDeclRsn!DECLINE_REASON_TEXT)
        
        Call eParent.appendChild(eChild)
            
        
        rsDeclRsn.MoveNext
  'End If
    Loop
  End If
  
  strXmlString = xmldoc.xml
  XMLCreateDeclineReason = True

  
  'Save XML Document
  'Shane:
  'barb:
  'xmldoc.Save ("C:\Shane\Projects\LCB\FormB\XML Docs\Response\FormB_Decline_Response.xml")
  'xmldoc.save ("D:\Projects\LCB\FormB\XML Docs\Response\FormB_Response.xml")
  
  'Call Index dll (pass all relevant info to the index table)
  'Call ErrorDll(XMLDoc.xml)
  
'clean up
Set xmldoc = Nothing
Set ProcessInst = Nothing
Set nKeytax = Nothing
Set nResponse = Nothing
Set nlKeytax = Nothing
Set nlResponse = Nothing
Set ellKeytax = Nothing
Set ellResponse = Nothing
Set ellSARSAppID = Nothing
Set ellDirectiveType = Nothing
Set ellCode = Nothing
Set ellTextReason = Nothing
  
PROC_EXIT:
Exit Function

PROC_ERROR:
XMLCreateDeclineReason = False
Err.Raise Err.Number, _
          "clsCreateXMLDecline/XMLCreateDeclineReason", _
          Err.Description
          
Resume PROC_EXIT
  
End Function 'XMLCreateDeclineReason()
Public Function CreateXmlVersionDtdHeader() As String
    Dim strXmlString As String

    strXmlString = "<?xml version=""1.0"" encoding=""UTF-8""?>" & Chr(13)
    'strXmlString = strXmlString & "<!DOCTYPE KeyTax SYSTEM ""C:\Shane\Projects\LCB\FormB\XML Docs\FormB_Response.dtd"">" & Chr(13)
    strXmlString = strXmlString & "<!DOCTYPE KeyTax SYSTEM """ & App.Path & "\FormB_Decline_Response.dtd"">" & Chr(13)
    
    CreateXmlVersionDtdHeader = strXmlString

End Function 'CreateXmlVersionDtdHeader



